#lang rosetta-racket


(provide backend-autocad-template
         render-with-floor
         render-with-floor!)


(define template-path (path->string (build-path (rosetta-distros-path) "autocad-render" "src" "template.dwt")))


(define (render-path file dir ext)
  (path->string (build-path dir (format "~A.~A" file ext))))

(define (display-render-msg width height path)
  (displayln (format "Render (~Ax~A) ~A" width height path)))


(define (backend-autocad-template)
  (begin0
    (backend autocad)
    (ac:close #f)
    (ac:open template-path)))


(define shapes-layer "DarkGray")

(define (make-render-shapes node/nodes)
  (evaluate (layer shapes-layer node/nodes)))


(define (floor-layer floor-color)
  (match floor-color
    ('white "Floor")
    ('black "FloorBlack")))

; edit: need to avoid 'clone-shape'
(define (make-render-floor w h col)
  (let ((z-min (reduce min (map bbox-min-z (map bbox (map clone-shape (get-shapes)))))))
    (evaluate
     (layer (floor-layer col) (rectangle-surface (z z-min) w h)))))


(define (render-shapes-and-floor node/nodes w h path type floor-w floor-h floor-col)
  (begin0
    ; edit: hack
    (unless (procedure? node/nodes)
      (make-render-shapes node/nodes))
    (let ((floor (make-render-floor floor-w floor-h floor-col)))
      (ac:com:set-sky-status-variable! ac:com:sky-status-background-and-illumination)
      (render-shapes w h path type)
      (delete-shape floor))))

(define (render-with-floor-impl node/nodes file dir ext width height type floor-width floor-height floor-color)
  (let ((path (render-path file dir ext)))
    (display-render-msg width height path)
    (render-shapes-and-floor node/nodes width height path type floor-width floor-height floor-color)))

(define (render-with-floor node/nodes file 
                           #:dir (dir (render-dir))
                           #:ext (ext (render-ext))
                           #:width (width (render-width))
                           #:height (height (render-height))
                           #:type (type (cfg-render-type))
                           #:floor-width (floor-width (render-floor-width))
                           #:floor-height (floor-height (render-floor-height))
                           #:floor-color (floor-color (render-floor-color)))
  (render-with-floor-impl node/nodes file dir ext width height type floor-width floor-height floor-color))

; edit: the λid is not correct
(define (render-with-floor! file
                            #:dir (dir (render-dir))
                            #:ext (ext (render-ext))
                            #:width (width (render-width))
                            #:height (height (render-height))
                            #:type (type (cfg-render-type))
                            #:floor-width (floor-width (render-floor-width))
                            #:floor-height (floor-height (render-floor-height))
                            #:floor-color (floor-color (render-floor-color)))
  (void
   (render-with-floor-impl λid file dir ext width height type floor-width floor-height floor-color)))